home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d26 / typdr11.arc / TYPDRILL.PAS < prev   
Pascal/Delphi Source File  |  1988-09-11  |  15KB  |  374 lines
  1. { TYPDRILL is a program that drills the user in typing speed and accuracy }
  2.  
  3. {$V-}    (* allow small strings to be passed to procedures *)
  4. {$I screenio.pas}  (* handles function keys and command lines *)
  5.  
  6. type   string14 = string [14];
  7.        string80 = string [80];
  8. const  n_diff = 6;          { number of degrees of difficulty }
  9.        time_incr = 100;     { 100 msec timer increments for measuring speed }
  10.        keyboard : array [0..n_diff] of string80 = (
  11. ' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.,;:?/()-+=$"''',
  12.                'asdfjkl;','asdfghjkl;',
  13.                'asdfghjkl;qwertyuiop',
  14.                'asdfghjkl;zxcvbnm,.',
  15.                'asdfghjkl;qwertyuiopzxcvbnm,./',
  16.                'asdfghjkl;qwertyuiopzxcvbnm,./ASDFGHJKL:QWERTYUIOPZXCVBNM<>?');
  17. var    o_rand : boolean;          { random letters? (or read from file) }
  18.        o_diff : integer;          { difficulty 1 to n_diff }
  19.        o_file : text;             { if file source, this is file ID }
  20.        o_disp : integer;          { 1=single character display, >1=whole line }
  21.        o_rept : boolean;          { repeat same character after error? }
  22.        index : integer;           { index into keyboard array if "random". }
  23.        lindex: integer;           { index into input line if "file". }
  24.        timer : integer;           { number of timer increments till keystroke }
  25.        keyTime, keyErr, keyTot: array [1..80] of integer;
  26.                                   { arrays of statistics counts: for the key in
  27.                                     keyboard[i], keyTime[i] = total time,
  28.                                     keyErr[i] = total errors, and
  29.                                     keyTot[i] = number of times that key
  30.                                        was called for. }
  31.        in_line : string80;
  32.        fline   : string80;
  33.        infname : string14;        { name of input file }
  34.        quitflag : boolean;        { true if we quit this pass }
  35.        c : char;                  { current character }
  36.        right, wrong, total, totTime : integer;
  37.        ii,jj,kk : integer;
  38.  
  39. procedure setup; forward;
  40. procedure statscreen; forward;
  41.  
  42. function nextchar : char;  { Return next character to be typed }
  43.            { Also (sorry for lack of modularity) provides its index into
  44.              keyboard string and, if necessary, the input line }
  45.     begin
  46.         if o_rand then
  47.         begin
  48.             index := random (length (keyboard[o_diff]) - 1) +1;
  49.                                   { random index into keyboard array }
  50.             nextchar := keyboard [o_diff][index];  { use it to get character }
  51.         end
  52.         else        { working from a file }
  53.         begin
  54.             while lindex>length(fline) do    { get next line from file }
  55.             begin
  56.                 lindex := 1;
  57.                 if EOF(o_file) then   { back to beginning of file }
  58.                 begin
  59.                     close (o_file);
  60.                     reset (o_file);
  61.                 end;
  62.                 readln (o_file, in_line);
  63.               (* Squeeze non-useful characters out before using *)
  64.                 fline := '';
  65.                 for ii:=1 to length (in_line) do
  66.                     if pos (in_line[ii], keyboard[o_diff]) > 0
  67.                     then  fline := concat (fline, in_line[ii]);
  68.             end;
  69.             nextchar := fline [lindex];
  70.             index := pos (fline[lindex], keyboard[o_diff]);
  71.             lindex := lindex+1;
  72.         end;
  73.     end;
  74.  
  75. procedure bannerchar (L :char; x,y :integer);
  76.    { write letter "L" in banner style, with upper left at <x,y>  }
  77.     const  bios = $F000;
  78.            gchar= $FA6E;
  79.     var    i,j : integer;
  80.            mask : byte;
  81.            blnk : char;  { blank character, underscore for base line }
  82.     begin
  83.         gotoXY (x-1,y-1);  write ('________________');
  84.         gotoXY (x-1,y+6);  write ('________________');
  85.         for i:=0 to 7 do
  86.         begin
  87.             gotoXY (x,y+i);
  88.             mask := 128;   { set leftmost bit of mask }
  89.             if i=6 then blnk:='_'  else blnk:=' ';
  90.             for j:=1 to 8 do
  91.             begin
  92.                 { index into the graphic char arry in BIOS }
  93.                 if (mem [bios: gchar+ (integer(L)*8) +i] and mask) =0
  94.                         then write (blnk, blnk)                   { blank }
  95.                         else write (char(219), char(219));  { solid }
  96.                 mask := mask shr 1;
  97.             end;
  98.         end;
  99.     end;
  100.  
  101. procedure move_cursor;
  102.     { Highlight the next character to type }
  103.     const  BOLD = $F;
  104.            NORM = $7;
  105.     begin
  106.         if lindex>2 then     { continue this line }
  107.         begin
  108.             { Need speed.  We'll write directly in display. Sorry! }
  109.             mem [DispTop: 795 + 2*(lindex)] := NORM; { 5*160 -2 -3 }
  110.             mem [DispTop: 797 + 2*(lindex)] := BOLD; { 5*160 -2 -1 }
  111.         end
  112.         else       { display new line }
  113.         begin
  114.             LowVideo;
  115.             gotoXY (1,6);  for ii:=1 to 80 do write (' ');
  116.             gotoXY (1,6);  write (fline);
  117.             gotoxy (1,6);  HighVideo; write (fline[1]); LowVideo;
  118.             gotoXY (1,7);  for ii:=1 to 80 do write (' ');
  119.             gotoxy (1,7);
  120.         end;
  121.     end;
  122.  
  123. procedure countdown;    (* screen countdown with BEEPs *)
  124.     var    i : integer;
  125.     begin
  126.         gotoXY (1,2); write ('READY   ');
  127.         for i:=5 downto 1 do
  128.         begin
  129.             gotoXY (7,2); write (i, ^G);
  130.             delay (700);
  131.         end;
  132.         gotoXY (1,2); write ('        ');
  133.     end;
  134.  
  135. procedure setup;    (* Initialize variables, read file if necessary *)
  136.     const intromax = 16;
  137.           intro : array [1..intromax] of string80 = (
  138. '                    T Y P E D R I L L',
  139. '                   -------------------',
  140. '            Copyright  Dave Tutelman  -  1988',
  141. '                   All rights reserved',
  142. '',
  143. ' "TYPEDRILL" is a program to increase the speed and accuracy of your typing.',
  144. ' It presents you with letters to type, and monitors how quickly and',
  145. ' accurately you type them.  It gives you running totals of your progress,',
  146. ' and can give more detailed statistics if you request them with the STATS',
  147. ' function key.',
  148. '',
  149. ' You can choose between two ways of using the program:',
  150. '   (1)  Single letters are presented (with several levels of difficulty)',
  151. '   (2)  Lines from a text file of your choice are presented.',
  152. '',
  153. ' Make your selection now:');
  154.     var    i : integer;
  155.     begin
  156.         clrscr;
  157.         gotoxy (1,2);  HighVideo;
  158.         for i:=1 to 3 do writeln (intro [i]);
  159.         LowVideo;
  160.         for i:=4 to intromax do writeln (intro [i]);
  161.         repeat           { prompt for random or file }
  162.             gotoxy (7,intromax+3);
  163.             write ('Random letters (R) or lines from a file (F)?  ');
  164.             read (kbd,c);
  165.             write (c);
  166.         until (c='r') or (c='R') or (c='f') or (c='F');
  167.         if (c='r') or (c='R') then o_rand := TRUE
  168.                               else o_rand := FALSE;
  169.         if o_rand then
  170.         begin
  171.           repeat           { prompt for degree of difficulty }
  172.               gotoxy (7,intromax+5);
  173.               write ('How difficult, from 1 (easy) to ',n_diff,' (hard) ?  ');
  174.               read (kbd,c);
  175.               write (c);
  176.               o_diff := integer(c) - 48;  { ASCII to int conversion }
  177.           until (o_diff>=1) and (o_diff<=n_diff);
  178.           o_disp := 1;
  179.           o_rept := TRUE;
  180.         end;
  181.  
  182.         if not o_rand then     { working from a file }
  183.         begin
  184.           repeat           { prompt for file name }
  185.               gotoxy (7,intromax+5);
  186.               write ('What file should we work from ?  ');
  187.               readln (infname);
  188.               assign (o_file, infname);
  189.               {$I-}  reset (o_file);  {$I+}
  190.               ii := IOresult;
  191.               if ii=0 then write('  Reading file.              ')
  192.                       else write('  Can''t open file. Try again!');
  193.           until (ii=0);
  194.           fline := ''; lindex := 100;   { force a new line to be read }
  195.           o_diff := 0;
  196.           o_disp := 2;
  197.           o_rept := FALSE;
  198.         end;
  199.  
  200.         clrscr;          { initialize screen with function key labels }
  201.         OnKey (1,' QUIT ');
  202.         OnKey (6,'STATS ');
  203.         OnKey (8,'RESET ');
  204.         quitflag := FALSE;
  205.         right:=0; wrong:=0; total:=0; totTime:=0;
  206.         for i:=1 to 80 do
  207.         begin
  208.             keyTot [i] := 0;
  209.             keyErr [i] := 0;
  210.             keyTime[i] := 0;
  211.         end;
  212.         c := nextchar;
  213.         lowVideo;
  214.         countdown;
  215.     end;
  216.  
  217. procedure statscreen;      { Display current performance statistics }
  218.     var    average, this : integer;
  219.     begin
  220.         clrscr;
  221.         OnKey (6,'CONTIN');
  222.  
  223.         { Display error statistics }
  224.         if total>0 then  average := (wrong * 1000) div total
  225.                    else  average := 0;
  226.         gotoXY (1,1); HighVideo;
  227.         write ('BATTING AVERAGE = ', 1000-average);
  228.         LowVideo;
  229.         for ii:=1 to length (keyboard [o_diff]) do
  230.             if keyTot[ii] > 0  then
  231.             begin
  232.                 gotoXY(ii,11); write (keyboard [o_diff][ii]);
  233.                 this := (keyErr[ii] *1000) div keyTot[ii];
  234.                 if average>0 then  this := (this * 2) div average
  235.                              else  this := 0;
  236.                                   { number of segments to plot }
  237.                 if this>9 then this:=9;
  238.                 for jj:=1 to this do
  239.                 begin
  240.                     gotoXY (ii, 11-jj);
  241.                     write (char(179));
  242.                 end;
  243.             end;
  244.         gotoXY (1,12); for ii:=1 to 80 do write (char (196));
  245.  
  246.         { Display speed statistics }
  247.         if total>0 then  average := totTime div total
  248.                    else  average := 0;    { avg # of time increments }
  249.         gotoXY (1,13); HighVideo;
  250.         write ('AVERAGE SPEED = ', average*time_incr, ' MilliSeconds');
  251.         LowVideo;
  252.         gotoXY (1,23-5);  { horizontal line at the average }
  253.         for ii:=1 to length (keyboard [o_diff]) do write ('-');
  254.         for ii:=1 to length (keyboard [o_diff]) do
  255.             if keyTot[ii] > 0 then
  256.             begin
  257.                 if (ii mod 5)=0  then HighVideo  else LowVideo;
  258.                 gotoXY(ii,23); write (keyboard [o_diff][ii]);
  259.                 this := keyTime[ii] div keyTot[ii];
  260.                 if average>0 then  this := (this * 5) div average
  261.                              else  this := 0;
  262.                                          { number of segments to plot }
  263.                 if this>9 then this:=9;
  264.                 for jj:=1 to this do
  265.                 begin
  266.                     gotoXY (ii, 23-jj);
  267.                     write (char(179));
  268.                 end;
  269.             end;
  270.         gotoXY (1,24); for ii:=1 to 80 do write (char (196));
  271.         gotoXY (1,1);  { get cursor out of the way }
  272.         repeat until not GetKey;
  273.         case inchar of
  274.           ';' :  { F1 = quit }
  275.               quitflag := TRUE;
  276.           'B' :  { F8 = reset }
  277.               setup;
  278.           else   { F6 = continue, anything else treat as F6 }
  279.               begin
  280.                   clrscr;
  281.                   OnKey (6,'STATS ');
  282.                   lindex := 200;   { Force next line }
  283.                   c := nextchar;
  284.                   countdown;
  285.               end;
  286.           end;
  287.     end;
  288.  
  289.  
  290. (*   MAIN  *)
  291. begin
  292.     setup;
  293.     repeat
  294.         if o_disp=1 then   { single letter display }
  295.         begin
  296.             gotoXY (20,6);  write ('Please type');
  297.             bannerchar (c,35,3);
  298.         end
  299.         else    { displaying lines }
  300.             move_cursor;
  301.         timer := 0;      { keystroke timing loop follows }
  302.         repeat
  303.             delay (time_incr);
  304.             timer := timer + 1;
  305.         until KeyPressed;
  306.         if GetKey then
  307.         begin
  308.             keyTot [index] := keyTot[index] + 1;
  309.             if c=inchar then
  310.             begin
  311.                 right := right+1;
  312.                 keyTime[index] := keyTime[index] + timer;
  313.                 totTime := totTime + timer;
  314.                 c := nextchar;
  315.             end
  316.             else
  317.             begin
  318.                 wrong := wrong+1;
  319.                 keyErr[index] := keyErr[index] + 1;
  320.                 if not o_rept  then  c:=nextchar;
  321.                 if o_disp=1 then  write (^G)       { beep if wrong }
  322.                             else  HighVideo;    { or mistake in bold }
  323.             end;
  324.             total := total+1;
  325.  
  326.             { Display short form of stats }
  327.             if o_disp=1  then      { every character, if single-char display }
  328.             begin
  329.                 gotoXY (20,14);  write ('You typed');
  330.                 gotoXY (35,14);  write (inchar);
  331.                 gotoXY (1,18);
  332.                 writeln (right:4,' right.');
  333.                 writeln (wrong:4,' wrong.');
  334.                 writeln (total:4,' total.');
  335.             end
  336.             else     { Every line, if line display }
  337.             begin
  338.                 { first echo typed character }
  339.                 if inchar>=' ' then write(inchar)
  340.                                else write('@');
  341.                 LowVideo;
  342.                 if lindex<=2 then
  343.                 begin
  344.                    gotoXY (1,20);
  345.                    writeln (total,'  keystrokes so far.');
  346.                    writeln ('        You got ',right,' right and ',
  347.                                             wrong,' wrong.');
  348.                    HighVideo; gotoXY (20,23);
  349.                    write ('PRESS ANY KEY TO CONTINUE');
  350.                    if not GetKey then
  351.                    case inchar of
  352.                      ';' :  { F1 = quit }
  353.                          quitflag := TRUE;
  354.                      'B' :  { F8 = reset }
  355.                          setup;
  356.                      '@' :  { F6 = statistics screen }
  357.                          statscreen;
  358.                    end;
  359.                    LowVideo;  gotoXY (20,23);
  360.                    write ('                         ');
  361.                 end;
  362.             end;
  363.         end
  364.         else case inchar of
  365.           ';' :  { F1 = quit }
  366.               quitflag := TRUE;
  367.           'B' :  { F8 = reset }
  368.               setup;
  369.           '@' :  { F6 = statistics screen }
  370.               statscreen;
  371.         end;
  372.     until quitflag;
  373.     clrscr;
  374. end.